perm filename SCAN.FAI[XX,LCS]1 blob
sn#209699 filedate 1976-04-06 generic text, type T, neo UTF8
00100 TITLE SCANR
00200 ENTRY SCANR
00250 EXTERNAL SCN,SC,ALF,NALF,EXP3.2,SCX
00300 ML←5 ↔ K←0 ↔ NNUM←14 ↔ ISKP←13 ↔ JJ←12 ↔ XMINUS←11 ↔ DECI←10
00400 M←7 ↔ N←6 ↔ QQ←4 ↔ TRIP←3
00500 DEFINE LL <SCN> ↔ DEFINE LR<SCN+1> ↔ DEFINE LBL <SCX+=15>
00600 DEFINE LSL <SCN+4> ↔ DEFINE LST <SCX+=11> ↔DEFINE LCM<SCX+4>
00700 DEFINE LE <SCN+5> ↔ DEFINE LC <SCN+6> ↔ DEFINE LS <SCN+7>
00800 DEFINE LPL<SCX+=10> ↔DEFINE LMI<SCX+5> ↔ DEFINE LF <SCN+=8>
00900 DEFINE LA <SCN+=9> ↔ DEFINE LI <SCN+=10> ↔ DEFINE LW <SCN+=11>
01000 DEFINE JN <SC+=10> ↔ DEFINE DBST <SC+=11> ↔ DEFINE ISEMI <SC+=14>
01100 DEFINE IXX <SC+=13> ↔ DEFINE MODE <SC+=70> ↔ DEFINE VX <SC+=16>
01150 DEFINE LU <SCN+2> ↔ DEFINE LD <SCN+3> ↔ DEFINE INP <ALF>
01160 DEFINE REXP<SC+6> ↔DEFINE DOT<SCX+6>
01175 IQ: BLOCK 12
01200 ; 00100 C SUBRS. SCANR, NALF, EDIT, PRESCN
01300 ; 00300 C ***** MSS SCANNER *************************
01400 ; 00400 SUBROUTINE SCANR
01500 ; 00500 DIMENSION IQ(10),LRUD(4)
01600 ; 00600 COMMON/ALF/INP(72),ML
01700 ;650 COMMON/SCN/LL,LR,LU,LD,LSL,LE,LC,LS,LF,LA,LI,LW
01710 ; COMMON/SCX/RHY(4),JALPHA(30),J4,L,Y,K,RX,RZ,RA,J5
01800 ; 00700 COMMON /SC/J,L,MK
01900 ; 00800 1 ,ISKP,XMINUS,N,REXP,LK,NNUM,JJ,JN,DBST,NFLG,IXX,ISEMI,QQ
02000 ; 00900 1 ,VX(50),IAMP,K,RRN,M,MODE,IBLA
02100 ;1000 EQUIVALENCE (IQ(1),VX(41)),(VX1,VX(1)),(VX2,VX(2)),(LDN,LRUD(4))
02200 ; 01100 DATA LRUD/'L','R','U','D'/
02300 ; 01200 C FOR LEFT, RIGHT, UP, DOWN, EDIT
02350 SCANR: 0
02400 MOVE ML,ALF+=72 ; 5 IS ML UNTIL RETURN
02500 ; 01300 NNUM=-1
02600 SETOM NNUM
02700 ; 01400 ISKP=0
02800 SETZM ISKP
02900 ; 01500 JJ=0
03000 SETZM JJ
03100 ; 01600 XMINUS=1.
03200 MOVSI XMINUS,201400
03300 ; 01700 C LEAVES BLANK WHEN REST.
03400 ; 01800 999 DECI=-1
03500 S999: SETOM DECI ;INTEGER UNTIL S11!
03600 ; 01900 M=0
03700 SETZM M
03800 ; 02000 2799 N=INP(ML)
03900 S2799: MOVE N,INP -1(ML)
04000 ; 02100 899 ML=ML+1
04100 S899: AOS ML
04200 CAMN N,LSL ; 02200 781 IF(N.EQ.'/')N=ISEMI
04300 MOVE N,ISEMI
04400 ; 02300 C FOR MOTIVIC TRANFORMATIONS
04500 ; 02380 IF(N.EQ.'*')GO TO 751
04600 CAME N,LST
04700 CAMN N,ISEMI
04800 JRST S751
04900 ; 02400 IF(N.EQ.ISEMI)GO TO 751
05000 ; 02500 C '*' AND '/' ADDED ABOVE 4/18/73
05100 ; 02600 IF(N.NE.IXX)GO TO 22
05200 CAMN N,IXX
05300 SKIPGE SC+=10 ; JN
05400 JRST S22
05500 ; 02650 IF(JN)GO TO 22
05600 ; 02700 IF(ISKP.EQ.0)GO TO 210
05700 JUMPE ISKP,S210
05800 ; 02800 ML=ML-1
05900 SOS ML
06000 ; 02900 GO TO 202
06100 JRST S202
06200 ; 03000 22 IF(N.EQ.IBLA)GO TO 4702
06300 S22: CAMN N,LBL
06400 JRST S4702
06500 ; 03050 IF(N.NE.',')GO TO 510
06600 CAME N,LCM
06700 JRST S510
06800 ; 03100 4702 IF(ISKP)202,2799,2799
06900 ; 03200 512 ML=ML+1
07000 S4702: JUMPGE ISKP,S2799
07100 JRST S202
07200 S512: MOVE 2,ISEMI
07300 AOS ML
07400 ; 03300 IF(INP(ML).EQ.ISEMI)RETURN
07500 CAMN 02,INP -1(ML)
07600 JRST SEND
07700 JRST S512+1
07800 ; 03400 GO TO 512
07900 ; 03600 510 IF(JN.GE.0)GO TO 173
08000 S510: MOVE 02,JN
08100 JUMPGE 02,S173
08200 ; 03700 C SKIP(JN=+1) IF NOT COMING FROM 'EDIT'
08300 ; 03800 JN=1
08400 MOVEI 02,1
08500 MOVEM 02,JN
08600 ; 03900 DO 702 K=1,4
08700 MOVEI 15,1
08800 ; 04000 702 IF(N.EQ.LRUD(K))GO TO 703
08900 S702: CAMN N,SCN -1(15)
09000 JRST S703
09100 CAIGE 15,4
09200 AOJA 15,S702
09300 ; 04100 C FINDS L, R, U, D
09400 ; 04200 C YOU CAN TYPE THE FULL WORD
09500 ; 04300 703 JJ=JJ+1
09600 S703: AOS JJ
09650 MOVE K,15
09700 ; 04400 IF(K.NE.4)GO TO 77
09800 CAIE K,4
09900 JRST S77
10000 ; 04450 IF(INP(ML).EQ.'E')K=99
10100 MOVE 2,LE
10200 CAMN 2,INP-1(ML)
10300 MOVEI K,=99 ; 04500 C 'DE'=DELETE
10400 ; 04600 77 IF(N.EQ.'E')K=55
10500 S77: CAMN N,LE
10600 MOVEI K,=55 ; 04700 C 'E'= EDIT
10700 ; 04800 IF(N.EQ.'C')K=2222
10800 CAMN N,LC
10900 MOVEI K,=2222 ; COPY
11000 ; 04900 IF(N.EQ.IXX)K=222
11100 CAMN N,IXX ; EXIT
11200 MOVEI K,=222
11300 ; 05000 C 'C'=COPY, 'X'=EXIT FROM EDIT MODE
11400 ; 05100 VX(JJ)=K
11500 TLC K,232000
11600 FADR K,K
11700 MOVEM K,VX-1(JJ)
11800 ; 05200 704 IF(INP(ML).EQ.IBLA)GO TO 2799
11900 S704: MOVE 2,INP-1(ML)
12000 CAME 2,LBL
12100 CAMN 2,LCM
12200 JRST S2799
12300 ; 05250 IF(INP(ML).EQ.',')GO TO 2799
12400 ; 05300 C PUT COMMA ERASER IN SCX.
12500 ; 05400 ML=ML+1
12600 AOS ML
12700 ; 05500 C SO IT WILL SKIP 'D' AND 'EL' IN 'EDIT' AND 'DEL'
12800 ; 05600 GO TO 704
12900 JRST S704
13000 ; 05700 173 K=NALF(N)
13100 S173: JSA 16,NALF
13200 JUMP N ; 0 IS K
13300 ; 05800 IF(N.GT.0)GO TO 1410
13400 JUMPG N,S1410
13500
13600 ; 05810 IF(K.EQ.18)GO TO 73
13700 CAIN =18
13900 JRST S73
14000
14100 ; 05815 C JUMP IF A REST OR OTHER R'S
14200
14300 ; 05820 IF(MODE.EQ.2)GO TO 144
14400 MOVEI 02,2
14500 CAMN 02,MODE
14600 JRST S144
14700 ; 05860 C YOU CAN TYPE 'S', ETC., FOR SIXTEENTH ETC., RHYTHM.
14800 ; 05900 C JUMP IF NOT A LETTER
14900 ; 06000 QQ=0
15000 SETZM QQ ; QQ IS 4
15100 CAIGE =8 ; 06100 IF(K.LT.8)GO TO 15
15200 JRST S15
15300 ; 06200 C JUMP IF A POSSIBLE NOTE
15400 ; 06300 IF(K.NE.11)GO TO 16
15500 CAIE =11
15600 JRST S16
15700 ; 06400 C JUMP IF NOT A KSIG
15800 ; 06500 18 N=INP(ML)
15900 S18: MOVE N,INP-1(ML)
16000 ; 06600 ML=ML+1
16100 AOS ML
16200 ; 06700 IF(N.EQ.IBLA)GO TO 18
16300 CAME N,LBL
16400 CAMN N,LS
16500 JRST S18
16600 ; 06750 IF(N.EQ.'S')GO TO 18
16700 ; 06775 IF(N.EQ.'+')GO TO 18
16800 CAMN N,LPL
16900 JRST S18
17000 ; 06800 IF(N.EQ.ISEMI)GO TO 20
17100 CAMN N,ISEMI
17200 JRST S20
17300 ; 06900 IF(N.EQ.'-')GO TO 177
17400 CAMN N,LMI
17500 JRST S177
17600 ; 06950 IF(N.NE.'F')GO TO 19
17700 CAME N,LF
17800 JRST S19
17900 ; 07000 177 QQ=-10000.
18000 S177: MOVN QQ,[10000.0]
18100 ; 07100 GO TO 18
18200 JRST S18
18300 ; 07200 19 A=NALF(N)
18400 S19: JSA 16,NALF
18500 JUMP N
18600 TLC K,232000
18700 FADR K,K ; K IS NOW A
18800 ; 07300 GO TO 18
18900 JRST S18
19000 ; 07400 20 VX(1)=-A*1000.-99.+QQ
19100 S20: FSBR QQ,[99.0]
19200 FMPRI K,212764
19300 FSBR QQ,K
19400 MOVEM QQ,VX
19500 ; 07500 C -4099=4 SHARPS, -14099=4 FLATS, ETC.
19600 ; 07600 RETURN
19700 JRST SEND
19800 ; 07700 16 IF(K.NE.9)GO TO 2
19900 S16: CAIE =9
20000 JRST S2
20100 ; 07800 VX(1)=22.
20200 MOVSI 02,205540
20300 MOVEM 02,VX
20400 ; 07900 C FOR EDIT I21 ETC.
20500 ; 08000 GO TO 2799
20600 JRST S2799
20700 ; 08100 2 IF(K.NE.13)GO TO 3
20800 S2: CAIE =13
20900 JRST S3
21000 ; 08200 C JUMP IF NOT A MEASURE LINE
21100 ; 08300 VX(1)=-599.
21200 MOVN 02,[599.0]
21300 MOVEM 02,VX
21400 ; 08310 JN=INP(ML)
21500 MOVE 1,INP -1(ML)
21550 MOVEM 1,JN
21600 ; 08320 IF(JN.NE.LD)GO TO 23
21700 CAME 1,LD
21800 JRST S23
21900 ; 08330 ML=ML+1
22000 AOS ML
22100 ; 08340 C FOUND 'MDN' -- FOR DOUBLE BARS
22200 ; 08350 JN=0
22300 SETZM JN
22400 ; 08360 VX(1)=-609.
22500 MOVN 02,[609.0]
22600 MOVEM 02,VX
22700 ; 08400 23 K=NALF(INP(ML))
22800 S23: JSA 16,NALF
22900 JUMP INP-1(ML)
23000 ; 08500 IF(K.LE.0)GO TO 512
23100 JUMPLE K,S512
23200 ; 08505 IF(K.GT.9)GO TO 512
23300 CAILE =9
23400 JRST S512
23500 ; 08510 IF(JN.EQ.0)K=K+10
23600 SKIPN JN
23700 ADDI =10
23800 ; 08575 VX(1)=-599.-K
23900 TLC K,232000
24000 FADR K,K
24100 FADR K,[599.0]
24200 MOVNM K,VX
24300 ; 08600 C 'M2'= A BAR LINE UP 2 STAVES. ETC.
24400 ; 08700 GO TO 512
24500 JRST S512
24600 ; 08800 3 IF(K.GT.16)GO TO 4
24700 S3: CAILE =16
24800 JRST S4
24900 ; 08900 C JUMP IF NOT FOR 'PROXIMITY' MODE
25000 ; 09000 NSWCH=K-15
25100 SUBI =15
25200 MOVEM K,NSWCH#
25300 ; 09100 GO TO 2799
25400 JRST S2799
25500 ;09200 TO SWITCH ALWAYS USE OCT.# /PBF4/ /OE5/ P=PROXIMITY, O=ORDINARY
25600 ; 09500 4 IF(K.NE.20)GO TO 21
25700 S4: CAIE =20
25800 JRST S21
25900 ; 09600 C TRY AGAIN IF NOT A 'T'
26000 ; 09700 IF(INP(ML).GT.0)GO TO 2799
26100 MOVE 3,INP -1(ML)
26200 JUMPG 3,S2799
26300 ;9800 T12,8/ ETC. MAKES A METER, OR TIME SIG. POS NUMS ARE NOT LETTERS!
26400 ; 09900 VX(1)=-199.
26500 MOVN 02,[199.0]
26600 ; 10000 IF(INP(ML).EQ.'E')VX(1)=-499.
26700 CAMN 3,LE
26800 MOVN 2,[499.0]
26900 MOVEM 02,VX
27000 ; 10100 GO TO 51
27100 JRST S51
27200 ; 10200 21 IF(K.NE.19)GO TO 899
27300 S21: CAIE =19
27400 JRST S899
27500 ; 10300 C JUMP IF NOT 'S' STEM
27600 ; 10400 VX(1)=-699.
27700 MOVN 03,[699.0] ; 10500 C UP=-699
27900 ; 10600 IF(INP(ML).EQ.LDN)VX(1)=-799.
28000 MOVE 2,INP-1(ML)
28100 CAMN 2,LD
28200 MOVN 3,[799.0] ; DOWN = -799
28300 MOVEM 03,VX
28500 JRST S512 ; 10700 GO TO 512
28600 ; 10800 C NEXT IT'S A NOTE OR CLEF
28700 ; 10900 15 NNUM=K-2
28800 S15: SUBI 2 ; NNUM IS NOW 0 (K)
28900 ; 11000 IF(NNUM.LE.0)NNUM=NNUM+7
29000 SKIPG
29100 ADDI 7
29200 MOVE NNUM,K
29300 ; 11100 N=INP(ML)
29400 MOVE N,INP -1(ML)
29500 ; 11200 IF(N.NE.'A')GO TO 5
29600 CAME N,LA
29700 JRST S5
29800 ; 11300 C JUMP IF NOT BASS CLEF
29900 ; 11400 VX(1)=-299.
30000 MOVN 02,[299.0]
30100 MOVEM 02,VX
30200 ; 11500 51 IF(XMINUS)VX(1)=VX(1)-.5
30300 S51: SKIPL XMINUS
30400 JRST S512
30500 MOVN 2,[0.5]
30600 FADRM 2,VX
30700 ; 11600 C TYPE '-BA' FOR INVISIBLE BASS CLEF, ETC.
30800 ; 11700 GO TO 512
30900 JRST S512
31000 ; 11800 5 IF(N.NE.'L')GO TO 6
31100 S5: CAME N,LL
31200 JRST S6
31300 ; 11900 C JUMP IF NOT ALTO CLEF
31400 ; 12000 VX(1)=-399.
31500 MOVN 02,[399.0]
31600 MOVEM 2,VX
31700 ; 12100 GO TO 51
31800 JRST S51
31900 S6: MOVEI K,1 ;6 K=1
32000 ; 12300 IF(NNUM.GT.3)K=2
32100 CAILE NNUM,3
32200 AOJ K,
32300 ; 12500 C FOUND A NOTE
32400 ; 12700 IF(N.EQ.IXX)GO TO 5410
32500 CAMN N,IXX
32600 JRST S5410
32700 ; 12800 C FOR GX3/ ETC.
32800 ; 12900 K=NALF(N)
32900 JSA 16,NALF
33000 JUMP N
33100 ; 13000 IF(N.GT.0)GO TO 7
33200 JUMPG N,S7
33300 ; 13100 C JUMP IF NOT A LETTER
33400 ; 13200 QQ=100000.
33500 MOVE QQ,[100000.0]
33600 ; 13300 IF(K.EQ.14)GO TO 610
33700 CAIN =14
33800 JRST S610
33900 ; 13400 IF(K.EQ.19)GO TO 8
34000 CAIN =19
34100 JRST S8
34200 ; 13500 C JUMP IF NATURAL
34300 ; 13600 QQ=1000.
34400 MOVSI QQ,212764
34500 ; 13800 GO TO 610
34600 JRST S610
34700 ; 13900 8 QQ=10000.
34800 S8: MOVE QQ,[10000.0]
34900 ; 14100 610 ML=ML+1
35000 S610: AOS ML
35100 ; 14200 K=NALF(INP(ML))
35200 JSA 16,NALF
35300 JUMP INP-1(ML)
35400 ; 14300 7 IF(K.EQ.11)GO TO 5410
35500 S7: CAIN =11
35600 JRST S5410
35700 ; 14350 IF(K.LT.0)GO TO 5410
35800 JUMPL K,S5410
35900 ; 14400 C JUMP IF SEMICOLON OR BLANK
36000 ; 14500 IF(K.NE.24)GO TO 24
36100 CAIN =24
36300 ; 14700 GO TO 5410
36400 JRST S5410
36500 ; 14800 24 JSCA=K-1
36600 S24: SOJ K, ; K IS JSCA FOR NOW
36700 MOVEM K,JSCA# ; SAVE IT
36750 MOVEM K,JSCA# ; SAVE IT
36800 ; 14900 ML=ML+1
36900 AOS ML
37000 ; 15100 GO TO 2410
37100 JRST S2410
37200 ; 15300 5410 IF(NSWCH.EQ.0)GO TO 2410
37300 S5410: MOVE 02,NSWCH
37400 JUMPE 02,S2410
37500 ; 15400 C K=-16 IS A BLANK??
37600 ; 15500 IF(K.EQ.-3)GO TO 277
37700 CAMN K,[-3]
37900 JRST S277
38000 ; 15550 IF(K.NE.-5)GO TO 7410
38100 CAME K,[-5]
38200 JRST S7410
38300 ; 15600 277 NOLD=NOLD-6*(K+4)
38400 S277: ADDI K,4
38500 IMULI K,6
38600 SUB K,NOLD#
38700 MOVNM K,NOLD
38800 ; 15700 ML=ML+1
38900 AOS ML
39000 ; 15800 C -=-3 +=-5 /B/B-/ JUMPS DOWN OCT., /B/B+/ UP OCT.
39100 ; 15910 7410 JJ=NOLD-NNUM
39200 S7410: MOVN JJ,NNUM
39300 ADD JJ,NOLD
39400 ; 15920 IF(JJ.LT.4)GO TO 377
39500 CAIGE JJ,4
39600 JRST S377
39700 ; 15950 IF(JSCA.LT.7)JSCA=JSCA+1
39800 MOVE JSCA
39850 CAIGE 7
39900 AOS JSCA
40000 ; 16010 377 IF(JJ.GT.-4)GO TO 2410
40100 S377: CAMLE JJ,[-4]
40200 JRST S2410
40300 ; 16050 IF(JSCA.GT.0)JSCA=JSCA-1
40400 SKIPLE JSCA
40500 SOS JSCA
40600 ;16100 WILL JUMP TO NEAREST NOTE (CHROM)**** MAY 22,71 (DIATONIC-'75)
40700 ; 16200 2410 JJ=1
40800 S2410: MOVEI JJ,1
40900 ; 16300 VX2=0
41000 SETZM VX+1
41100 ; 16410 VX1=(JSCA*7+NNUM+QQ)*DBST
41200 MOVE 2,JSCA
41300 IMULI 2,7
41400 ADD 2,NNUM
41500 TLC 2,232000
41600 FADR 2,2
41650 FADR 2,QQ
41700 FMPR 2,DBST
41800 MOVEM 2,VX
41900 ; 16500 C DOUBLE STOPS ARE NEG. NUMBERS
42000 ; 16600 NOLD=NNUM
42100 MOVEM NNUM,NOLD
42200 ; 16700 4410 NNUM=-2
42300 S4410: MOVNI NNUM,2
42400 ; 16800 IF(INP(ML).EQ.ISEMI)RETURN
42500 MOVE 02,ISEMI
42600 CAMN 02,INP -1(ML)
42700 JRST SEND
42800 ;16900 ABOVE FINDS SCALE NOTES; IF NSWCH=0 OCT. NUM WILL STICK UNTIL RESET
42900 ; 17000 GO TO 310
43000 JRST S310
43100 ; 17100 210 JJ=JJ+1
43200 S210: AOS JJ
43300 ; 17200 IF(JJ.EQ.1)GO TO 3310
43400 CAIN JJ,1
43500 JRST S3310
43600 ; 17300 XMINUS=1.
43700 MOVSI XMINUS,201400
43800 ; 17400 VX(JJ)=0
43900 SETZM VX -1(JJ)
44000 ;17500 C 'X N1,N2' MAY REPLACE 'REP N1,N2'. N2=0 BECOMES N2=2
44100 ; 17600 GO TO 310
44200 JRST S310
44300 ; 17800 C JUMP IF A LETTER
44400 ; 17900 1410 IF(N.NE.'-')GO TO 14
44500 S1410: CAME N,LMI
44600 JRST S14
44700 ; 18000 XMINUS=-1.
44800 MOVN XMINUS,[1.0]
44900 ; 18100 GO TO 2799
45000 JRST S2799
45100 ; 18102 144 TRIP=0
45200 S144: SETZM TRIP
45300 ; 18105 444 IF(K.EQ.8)VX1=2
45400 S444: CAIE =8
45500 JRST .+3
45600 MOVSI 2,202400
45700 JRST SVX
45800 ; 18107 IF(K.EQ.4)VX1=.5
45900 CAIE 4
46000 JRST .+3
46100 MOVSI 2,200400
46200 JRST SVX
46300 ; 18110 IF(K.EQ.5)VX1=8
46400 CAIE 5
46500 JRST .+3
46600 MOVSI 02,204400
46700 JRST SVX
46800 ; 18115 IF(K.EQ.7)VX1=88
46900 CAIE 7
47000 JRST .+3
47100 MOVSI 02,207540
47200 JRST SVX
47300 ; 18120 IF(K.EQ.19)VX1=16
47400 CAIE =19
47500 JRST .+3
47600 MOVSI 02,205400
47700 JRST SVX
47900 ; 18125 IF(K.NE.20)GO TO 244
48000 CAIE =20
48100 JRST S244
48200 ; 18126 VX1=12
48300 MOVSI 02,204600
48400 MOVEM 02,VX
48500 ; 18127 N=INP(ML)
48600 MOVE N,INP -1(ML)
48700 ; 18129 IF(N.EQ.LBL)GO TO 344
48800 CAME N,LBL
48900 CAMN N,ISEMI
49000 JRST S344
49100 ; 18131 IF(N.EQ.ISEMI)GO TO 344
49200 ; 18133 TRIP=-1
49300 MOVSI TRIP,576400
49400 ; 18150 ML=ML+1
49500 AOS ML
49600 ; 18155 K=NALF(N)
49700 JSA 16,NALF
49800 JUMP N
49900 ; 18160 GO TO 444
50000 JRST S444
50100 ; 18220 244 IF(K.EQ.23)VX1=1
50200 S244: CAIE =23
50300 JRST .+3
50400 MOVSI 02,201400
50500 JRST .+4
50600 ; 18222 IF(K.EQ.17)VX1=4
50700 CAIE =17
50800 JRST .+3
50900 MOVSI 02,203400
51000 SVX: MOVEM 02,VX
51100 ; 18223 C TS=24TH, TQ=6, TH=3.
51200 ;18224 FOR S,E,Q,H,W,D,T RHYTH. 'T'(K=20) =TRIPLET D=DBL WHL NOTE
51300 ; 18225 IF(TRIP)VX1=VX1*1.5
51400 JUMPGE TRIP,S344
51500 MOVSI 2,201600
51600 FMPRM 02,VX
51700 ; 18226 344 JJ=JJ+1
51800 S344: AOS JJ
51900 ; 18228 GO TO 1310
52000 JRST S1310
52100 ; 18230 14 ISKP=-1
52200 S14: SETOM ISKP
52300 ; 18300 IF(N.NE.'.')GO TO 79
52400 CAME N,DOT
52500 JRST S79
52600 ; 18400 DECI=M
52700 MOVE DECI,M
53000 ; 18500 GO TO 75
53100 JRST S75
53200 ; 18600 79 M=M+1
53300 S79: AOS M
53400 ; 18700 IQ(M)=NALF(N)
53500 JSA 16,NALF
53600 JUMP N
53700 MOVEM 00,IQ -1(M)
53800 ; 18800
53900 ; 18900 75 IF(N.EQ.ISEMI)GO TO 751
54000 S75: CAMN N,ISEMI
54100 JRST S751
54200 ; 18950 IF(INP(ML).NE.1)GO TO 2799
54300 MOVEI 02,1
54400 CAME 02,INP -1(ML)
54500 JRST S2799
54600 ; 19000 751 IF(ISKP.EQ.0)RETURN
54700 S751: JUMPE ISKP,SEND
54900 ; 19100 202 IF(DECI.NE.-1)GO TO 302
55000 S202: CAME DECI,[-1]
55200 JRST S302
55300
55400 ; 19200 DECI=0
55500 SETZM DECI
55600
55700 ; 19300 GO TO 402
55800 JRST S402
55900
56000 ; 19400 302 DECI=M-DECI
56100 S302: SUB DECI,M
56200 MOVNS DECI
56500 ; 19500 402 RRN=0
56600 S402: SETZM RRN#
56700 ; 19600 REXP=M-1
56800 MOVNI 02,1
56900 ADD 02,M
57000 TLC 2,232000
57100 FADR 2,2
57200 MOVEM 2,REXP
57300 ; 19700 IF(M.LT.1)M=1
57400 CAIGE M,1
57500 MOVEI M,1
57600 ; 19800 DO 171 K=1,M
57700 MOVEI QQ,1 ;USE QQ FOR INDEX
57800 ; 19900 IF(REXP.GT.1)GO TO 1
57900 S171: MOVSI 02,201400
58000 CAMGE 02,REXP
58100 JRST S1
58200 ; 20000 RRV=10
58300 MOVSI 02,204500 ; RRV IS IN 2
58400 ; 20100 IF(REXP.EQ.0)RRV=1
58500 SKIPN REXP
58600 MOVSI 02,201400
58800 ; 20200 GO TO 11
58900 JRST S11
59000 ; 20300 1 RRV=10.**REXP
59100 S1: MOVSI 02,204500
59200 MOVE 03,REXP
59300 PUSHJ 17,EXP3.2
59500 ; 20400 11 RRN=RRN+IQ(K)*RRV
59600 S11: MOVE 3,IQ-1(QQ)
59700 TLC 3,232000
59800 FADR 3,3
59900 FMPR 2,3
60000 FADRM 2,RRN
60100 ; 20500 171 REXP=REXP-1
60200 MOVSI 02,576400
60300 FADRM 02,REXP
60400 CAMGE QQ,M
60500 AOJA QQ,S171
60510 JUMPE DECI,.+7
60520 TLC DECI,232000
60530 FADR DECI,DECI
60600 ; 20600 A=10.**DECI
60700 MOVSI 02,204500
60800 MOVE 03,DECI
60900 PUSHJ 17,EXP3.2 ; A WILL BE IN AC2
61000 ; 20700 IF(DECI.EQ.0)A=1.
61100 SKIPA
61200 MOVSI 02,201400
61400 ; 20800 JJ=JJ+1
61500 AOS JJ
61600 ; 20900 VX(JJ)=RRN/A*XMINUS
61700 MOVE 1,RRN
61800 FDVR 1,2
61900 FMPR 1,XMINUS
62000 MOVEM 1,VX -1(JJ)
62100 ; 21000 JN=-JN
62200 MOVNS 00,JN
62300 ; 21100 C SETS IT TO -1 FOR L,R,U,D EDIT ROUTINE
62400 ; 21200 IF(MODE.NE.2)XMINUS=1.
62500 MOVEI 02,2
62600 CAME 02,MODE
62700 MOVMS XMINUS
63000 ; 21300 C************: MODE #?
63100 ; 21400 C ONLY ONE - NEEDED FOR RHY.COMPOSITE
63200 ; 21500 1310 IF(INP(ML).NE.1)GO TO 310
63300 S1310: MOVEI 3,1
63400 CAME 3,INP -1(ML)
63500 JRST S310
63600 ; 21600 VX(JJ+1)=VX(JJ)*2.
63700 MOVE 02,VX -1(JJ)
63800 FSC 02,1
63900 MOVEM 02,VX (JJ)
64000 ; 21700 JJ=JJ+1
64100 AOS JJ
64200 ; 21800 ML=ML+1
64300 AOS ML
64400 ; 21900 GO TO 1310
64500 JRST S1310 +1
64600 ; 22000 206 ML=ML+2
64700 S206: ADDI ML,2
64800 ; 22100 3310 VX(1)=-99.
64900 S3310: MOVN 02,[99.0]
65000 MOVEM 02,VX
65100 ; 22200 310 ISKP=0
65200 S310: SETZM ISKP
65300 ; 22300 IF(N.NE.ISEMI)GO TO 999
65400 CAME N,ISEMI
65500 JRST S999
65600 ; 22500 RETURN
65700 SEND: MOVEM ML,ALF+=72
65800 MOVEM JJ,SC+=9
65900 JRA 16,(16)
66000 ; 22600 73 JJ=JJ+1
66100 S73: AOS JJ
66200 ; 22650 K=INP(ML)
66300 MOVE K,INP -1(ML)
66400 ; 22700 IF(K.EQ.'E')GO TO 206
66500 CAMN K,LE
66600 JRST S206
66700 ; 22800 C NEXT IS FOR A REST/R/ OR /RI/ FOR INVIS. REST
66800 ; 22810 IF(K.EQ.'D')GO TO 1073
66900 CAMN K,LD
67000 JRST S1073
67100 ; 22820 C /RD/ OR /RU/ = REST 6 DOWN OR 6 UP.
67200 ; 22830 IF(K.EQ.'U')GO TO 1173
67300 CAMN K,LU
67400 JRST S1173
67500 ; 22900 IF(K.EQ.'I')GO TO 573
67600 CAMN K,LI
67700 JRST S573
67800 ; 22910 IF(K.EQ.'W')GO TO 273
67900 CAMN K,LW
68000 JRST S273
68100 ; 22920 C /RW/ MAKES WHOLE REST REGARDLESS OF TIME VALUE GIVEN.
68200 ; 22930 C *** ADD NUMBERS LATER *****
68300 ; 22932 K=NALF(K)
68400 JSA 16,NALF
68500 JUMP K
68600 ; 22934 IF(K)GO TO 673
68700 JUMPL K,S673
68800 ; 22936 IF(K.GE.10)GO TO 673
68900 CAIL =10
69000 JRST S673
69100 ; 22940 973 KV=NALF(INP(ML+1))
69200 S973: MOVE 15,K
69300 JSA 16,NALF
69400 JUMP INP(ML)
69500 ; 22941 C FOR 3-DIG. NUMBS. CAN TAKE NUM UP TO 999 FOR RESTS.
69600 ; 22942 IF(KV)GO TO 873
69700 JUMPL S873
69800 ; 22944 IF(KV.GE.10)GO TO 873
69900 CAIL =10
70000 JRST S873
70100 ; 22945 ML=ML+1
70200 AOS ML
70300 ; 22946 K=K*10+KV
70400 IMULI 15,=10
70500 IMUL 02,K
70600 ADD 15,K ; 15 IS K FOR NOW AND K IS IV
70700 ; 22948 GO TO 973
70800 JRST S973+1
70900
71000 ; 22950 873 QQ=K+87
71100 S873: ADDI 15,=87 ; QQ IS 15 NOW
71200 TLC 15,232000
71300 FADR 15,15
71400 ; 22951 GO TO 473
71500 JRST S473
71600 ; 22952 673 QQ=85
71700 S673: MOVSI 15,207524
71800 ; 22956 GO TO 373
71900 JRST S373
72000 ; 22960 573 QQ=86
72100 S573: MOVSI 15,207530
72200 ; 22970 GO TO 473
72300 JRST S473
72400 ; 22980 273 QQ=87
72500 S273: MOVSI 15,207534
72600 ; 22990 473 ML=ML+1
72700 S473: AOS ML
72800 ; 23000 373 VX(JJ)=QQ
72900 S373: MOVEM 15,VX-1(JJ)
73000 ; 23300 GO TO 4410
73100 JRST S4410
73200 ; 23310 1073 QQ=20001
73300 S1073: MOVE 15,[20001.0]
73400 ; 23320 GO TO 473
73500 JRST S473
73600 ; 23330 1173 QQ=20000
73700 S1173: MOVE 15,[20000.0]
73800 ; 23340 GO TO 473
73900 JRST S473
74000 END ;23400 END